home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / inc / set.inc < prev    next >
Text File  |  1998-09-21  |  14KB  |  455 lines
  1. {
  2.     $Id: set.inc,v 1.6 1998/07/30 12:16:29 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993,97 by Carl-Eric Codere,
  5.     member of the Free Pascal development team.
  6.  
  7.     See the file COPYING.FPC, included in this distribution,
  8.     for details about the copyright.
  9.  
  10.     This program is distributed in the hope that it will be useful,
  11.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  
  14.  **********************************************************************}
  15. {*************************************************************************}
  16. {  Converted by Carl Eric Codere                                          }
  17. {*************************************************************************}
  18. {  This inc. implements low-level set operations for the motorola         }
  19. {  68000 familiy of processors.                                           }
  20. {  Based on original code bt Florian Kl„mpfl  for the 80x86.              }
  21. {*************************************************************************}
  22.  
  23.  
  24.   { add the element b to the set pointed by p }
  25.   { On entry                                   }
  26.   {  a0    = pointer to set                    }
  27.   {  d0.b  = element to add to the set         }
  28.   { Registers destroyed: d0,a1,d6              }
  29.   procedure do_set;assembler;
  30.   asm
  31.     XDEF SET_SET_BYTE
  32.           move.l  d0,d6
  33.           { correct long position: }
  34.           {   -> (value div 32)*4 = longint }
  35.           {       (value shr 5)*shl 2       }
  36.           lsr.l  #5,d6
  37.           lsl.l  #2,d6
  38.           adda.l d6,a0       { correct offset from start address of set }
  39.  
  40.           move.l d0,d6       { bit is now in here                       }
  41.           andi.l #31,d0      { bit number is =  value mod 32            }
  42.  
  43.           { now bit set the value }
  44.           move.l  (a0),d0              { we must put bits into register }
  45.           bset.l  d6,d0                { otherwise btst will be a byte  }
  46.           { put result in carry flag } { operation.                     }
  47.           bne    @LDOSET1
  48.           andi.b #$fe,ccr              { clear carry flag }
  49.           bra    @LDOSET2
  50.        @LDOSET1:
  51.           ori.b  #$01,ccr              { set carry flag   }
  52.        @LDOSET2:
  53.           move.l  d0,(a0)              { restore the value at that location }
  54.                                        { of the set.                        }
  55.     end;
  56.  
  57.     { Finds an element in a set }
  58.     { a0   = address of set                                 }
  59.     { d0.b = value to compare with                          }
  60.     { CARRY SET IF FOUND ON EXIT                            }
  61.     { Registers destroyed: d0,a0,d6                         }
  62.   procedure do_in; assembler;
  63.   { Returns Carry set then = in set , otherwise carry is cleared }
  64.   {         (D0)                                                 }
  65.   asm
  66.        XDEF SET_IN_BYTE
  67.           move.l  d0,d6
  68.           { correct long position: }
  69.           {   -> (value div 32)*4 = longint }
  70.           {       (value shr 5)*shl 2       }
  71.           lsr.l  #5,d6
  72.           lsl.l  #2,d6
  73.           adda.l d6,a0       { correct offset from start address of set }
  74.  
  75.           move.l d0,d6       { bit is now in here                       }
  76.           andi.l #31,d0      { bit number is =  value mod 32            }
  77.  
  78.           move.l  (a0),d0              { we must put bits into register }
  79.           btst.l  d6,d0                { otherwise btst will be a byte  }
  80.           { put result in carry flag } { operation.                     }
  81.           bne    @LDOIN1
  82.           andi.b #$fe,ccr              { clear carry flag }
  83.           bra    @LDOIN2
  84.        @LDOIN1:
  85.           ori.b  #$01,ccr             { set carry flag   }
  86.        @LDOIN2:
  87.     end;
  88.  
  89.  
  90.  
  91.    { vereinigt set1 und set2 und speichert das Ergebnis in dest }
  92.  
  93.    procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
  94.    {  PSEUDO-CODE:
  95.        type
  96.          destination = array[1..8] of longint;
  97.         for i:=1 to 8 do
  98.            destination(dest^)[i] := destination(set1^)[i] OR destination(set2^)[i];
  99.     }
  100.     begin
  101.         asm
  102.            { saved used register }
  103.            move.l a2,-(sp)
  104.  
  105.            move.l 8(a6),a0
  106.            move.l 12(a6),a1
  107.            move.l 16(a6),a2
  108.  
  109.            move.l #32,d6
  110.  
  111.        @LMADDSETS1:
  112.  
  113.            move.b  (a0)+,d0
  114.            or.b    (a1)+,d0
  115.            move.b  d0,(a2)+
  116.            subq.b  #1,d6
  117.            bne     @LMADDSETS1
  118.            { restore register }
  119.            move.l  a2,(sp)+
  120.         end ['d0','d6','a0','a1'];
  121.      end;
  122.  
  123.    { computes the symetric diff from set1 to set2    }
  124.    { result in dest                                  }
  125.  
  126.    procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
  127.  
  128.      begin
  129.         asm
  130.            { saved used register }
  131.            move.l a2,-(sp)
  132.  
  133.            move.l 8(a6),a0
  134.            move.l 12(a6),a1
  135.            move.l 16(a6),a2
  136.  
  137.            move.l #32,d6
  138.  
  139.        @LMADDSETS1:
  140.  
  141.            move.b  (a0)+,d0
  142.            move.b  (a1)+,d1
  143.            eor.b   d1,d0
  144.            move.b  d0,(a2)+
  145.            subq.b  #1,d6
  146.            bne     @LMADDSETS1
  147.            { restore register }
  148.            move.l  a2,(sp)+
  149.         end;
  150.      end;
  151.  
  152.  
  153.   { bad implementation, but it's very seldom used }
  154.   procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
  155.  
  156.     begin
  157.        asm
  158.           move.b h,d0
  159.        @LSetRLoop:
  160.           cmp.b  l,d0
  161.           blt    @Lend
  162.           move.w d0,-(sp)
  163.           { adjust value to correct endian }
  164.           lsl.w  #8,d0
  165.           pea    p
  166.           jsr    SET_SET_BYTE
  167.           sub.b  #1,d0
  168.           bra    @LSetRLoop
  169.        @Lend:
  170.        end;
  171.     end;
  172.  
  173.  
  174.    { bildet den Durchschnitt von set1 und set2 }
  175.    { und speichert das Ergebnis in dest        }
  176.  
  177.    procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
  178.    {  type
  179.          larray = array[0..7] of longint;
  180.         for i:=0 to 7 do
  181.            larray(dest^)[i] := larray(set1^)[i] AND larray(set2^)[i];
  182.    }
  183.    begin
  184.         asm
  185.            { saved used register }
  186.            move.l a2,-(sp)
  187.            move.l 8(a6),a0
  188.            move.l 12(a6),a1
  189.            move.l 16(a6),a2
  190.  
  191.            move.l #32,d6
  192.  
  193.        @LMMULSETS1:
  194.  
  195.            move.b  (a0)+,d0
  196.            and.b   (a1)+,d0
  197.            move.b  d0,(a2)+
  198.            subq.b  #1,d6
  199.            bne     @LMMULSETS1
  200.            { restore register }
  201.            move.l  a2,(sp)+
  202.         end ['d0','d6','a0','a1'];
  203.      end;
  204.  
  205.  
  206.    { bildet die Differenz von set1 und set2 }
  207.    { und speichert das Ergebnis in dest     }
  208.  
  209.    procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
  210.    {  type
  211.          larray = array[0..7] of longint;
  212.      begin
  213.         for i:=0 to 7 do
  214.            larray(dest^)[i] := larray(set1^)[i] AND NOT (larray(set2^)[i]);
  215.      end;
  216.      }
  217.    begin
  218.         asm
  219.            { saved used register }
  220.            move.l a2,-(sp)
  221.            move.l 8(a6),a0
  222.            move.l 12(a6),a1
  223.            move.l 16(a6),a2
  224.  
  225.            move.l #32,d6
  226.  
  227.        @LSUBSETS1:
  228.            move.b  (a0)+,d0
  229.            move.b  (a1)+,d1
  230.            not.b   d1
  231.            and.b   d1,d0
  232.            move.b  d0,(a2)+
  233.            sub.b   #1,d6
  234.            bne     @LSUBSETS1
  235.            { restore register }
  236.            move.l  a2,(sp)+
  237.         end ['d0','d1','d6','a0','a1'];
  238.      end;
  239.  
  240.    { compare both sets }
  241.    { compares set1 and set2                             }
  242.    { zeroflag is set if they are equal                  }
  243.    { on entry :  a0 = pointer to first set              }
  244.    {          :  a1 = pointer to second set             }
  245.    procedure comp_sets; assembler;
  246.  
  247.         asm
  248.          XDEF SET_COMP_SETS
  249.            move.l #32,d6
  250.        @LMCOMPSETS1:
  251.            move.b (a0)+,d0
  252.            move.b (a1),d1
  253.            cmp.b  d1,d0
  254.            bne    @LMCOMPSETEND
  255.            adda.l #1,a1
  256.            sub.b  #1,d6
  257.            bne    @LMCOMPSETS1
  258.            { we are here only if the two sets are equal         }
  259.            { we have zero flag set, and that what is expected   }
  260.            cmp.b  d0,d0
  261.        @LMCOMPSETEND:
  262.      end;
  263.  
  264.   procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
  265.   begin
  266.      asm
  267.           move.l 8(a6),a0
  268.           move.w 12(a6),d6
  269.           andi.l #$fff8,d6
  270.           lsl.l  #3,d6
  271.           adda.l d6,a0
  272.           move.b 12(a6),d6
  273.           andi.l #7,d6
  274.  
  275.           move.l  (a0),d0              { we must put bits into register }
  276.           btst.l  d6,d0                { otherwise btst will be a byte  }
  277.           { put result in carry flag } { operation.                     }
  278.           bne    @LBIGDOSET1
  279.           andi.b #$fe,ccr              { clear carry flag }
  280.           bra    @LBIGDOSET2
  281.        @LBIGDOSET1:
  282.           ori.b  #$01,ccr              { set carry flag   }
  283.        @LBIGDOSET2:
  284.        end ['d0','a0','d6'];
  285.   end;
  286.  
  287.   { testet, ob das Element b in der Menge p vorhanden ist }
  288.   { und setzt das Carryflag entsprechend                  }
  289.  
  290.   procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
  291.     begin
  292.       asm
  293.           move.l  8(a6),a0
  294.           move.w  12(a6),d6
  295.           andi.l  #$fff8,d6
  296.           lsl.l   #3,d6
  297.           adda.l  d6,a0       { correct offset from start address of set }
  298.  
  299.           move.b 12(a6),d6
  300.           andi.l #7,d6
  301.  
  302.           move.l  (a0),d0              { we must put bits into register }
  303.           btst.l  d6,d0                { otherwise btst will be a byte  }
  304.           { put result in carry flag } { operation.                     }
  305.           bne    @LBIGDOIN1
  306.           andi.b #$fe,ccr              { clear carry flag }
  307.           bra    @LBIGDOIN2
  308.        @LBIGDOIN1:
  309.           ori.b  #$01,ccr              { set carry flag   }
  310.        @LBIGDOIN2:
  311.        end ['d0','a0','d6'];
  312.     end;
  313.  
  314.  
  315.    { vereinigt set1 und set2 und speichert das Ergebnis in dest }
  316.    { size is the number of bytes in the set }
  317.  
  318.    procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_ADD_SETS_SIZE'];
  319.     begin
  320.         asm
  321.            { saved used register }
  322.            move.l a2,-(sp)
  323.            move.l 8(a6),a0
  324.            move.l 12(a6),a1
  325.            move.l 16(a6),a2
  326.  
  327.            move.l 20(a6),d6
  328.  
  329.        @LBIGMADDSETS1:
  330.  
  331.            move.l  (a0)+,d0
  332.            or.l    (a1)+,d0
  333.            move.l  d0,(a2)+
  334.            subq.l  #4,d6
  335.            bne     @LBIGMADDSETS1
  336.            { restore register }
  337.            move.l  a2,(sp)+
  338.         end ['d0','d6','a0','a1'];
  339.      end;
  340.  
  341.  
  342.    procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_MUL_SETS_SIZE'];
  343.    { bildet den Durchschnitt von set1 und set2 }
  344.    { und speichert das Ergebnis in dest        }
  345.    { size is the number of bytes in the set }
  346.    begin
  347.         asm
  348.            { saved used register }
  349.            move.l a2,-(sp)
  350.            move.l 8(a6),a0
  351.            move.l 12(a6),a1
  352.            move.l 16(a6),a2
  353.  
  354.            move.l 20(a6),d6
  355.  
  356.        @LBIGMMULSETS1:
  357.  
  358.            move.l  (a0)+,d0
  359.            and.l    (a1)+,d0
  360.            move.l  d0,(a2)+
  361.            subq.l  #4,d6
  362.            bne     @LBIGMMULSETS1
  363.            { restore register }
  364.            move.l  a2,(sp)+
  365.         end ['d0','d6','a0','a1'];
  366.      end;
  367.  
  368.  
  369.    { bildet die Differenz von set1 und set2 }
  370.    { und speichert das Ergebnis in dest     }
  371.    { size is the number of bytes in the set }
  372.  
  373.    procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
  374.    begin
  375.         asm
  376.            { saved used register }
  377.            move.l a2,-(sp)
  378.            move.l 8(a6),a0
  379.            move.l 12(a6),a1
  380.            move.l 16(a6),a2
  381.  
  382.            move.l 20(a6),d6
  383.  
  384.        @BIGSUBSETS1:
  385.  
  386.            move.l  (a0)+,d0
  387.            not.l   d0
  388.            and.l   (a1)+,d0
  389.            move.l  d0,(a2)+
  390.            subq.l  #4,d6
  391.            bne     @BIGSUBSETS1
  392.            { restore register }
  393.            move.l  a2,(sp)+
  394.         end ['d0','d6','a0','a1'];
  395.      end;
  396.  
  397.  
  398.    { vergleicht Mengen und setzt die Flags entsprechend }
  399.  
  400.    procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
  401.  
  402.  
  403.      begin
  404.         asm
  405.            move.l 8(a6),a0  { set1 - esi}
  406.            move.l 12(a6),a1 { set2 - edi }
  407.            move.l 16(a6),d6
  408.        @MCOMPSETS1:
  409.            move.l (a0)+,d0
  410.            move.l (a1),d1
  411.            cmp.l  d1,d0
  412.            bne  @BIGMCOMPSETEND
  413.            add.l #4,a1
  414.            subq.l #1,d6
  415.            bne  @MCOMPSETS1
  416.            { we are here only if the two sets are equal         }
  417.            { we have zero flag set, and that what is expected   }
  418.            cmp.l d0,d0
  419.        @BIGMCOMPSETEND:
  420.         end;
  421.      end;
  422.  
  423. {
  424.   $Log: set.inc,v $
  425.   Revision 1.6  1998/07/30 12:16:29  carl
  426.     * set_sub_sets bugfix, was not using correct operation
  427.  
  428.   Revision 1.5  1998/07/01 14:27:13  carl
  429.     * set_set and set_in bugfix
  430.  
  431.   Revision 1.2  1998/03/27 23:47:35  carl
  432.     * bugfix of FLAGS as return values for SET_IN_BYTE and SET_SET_BYTE
  433.  
  434.   Revision 1.4  1998/01/26 12:01:42  michael
  435.   + Added log at the end
  436.  
  437.  
  438.   
  439.   Working file: rtl/m68k/set.inc
  440.   description:
  441.   ----------------------------
  442.   revision 1.3
  443.   date: 1998/01/05 00:34:50;  author: carl;  state: Exp;  lines: +349 -350
  444.   * Silly syntax errors fixed.
  445.   ----------------------------
  446.   revision 1.2
  447.   date: 1997/12/01 12:37:22;  author: michael;  state: Exp;  lines: +14 -0
  448.   + added copyright reference in header.
  449.   ----------------------------
  450.   revision 1.1
  451.   date: 1997/11/28 16:51:20;  author: carl;  state: Exp;
  452.   + set routines for m68k.
  453.   =============================================================================
  454. }
  455.